home *** CD-ROM | disk | FTP | other *** search
/ Delphi Programmer's Power Pack / Delphi Volume 1.iso / e_to_l / fbuilder / delphi / demos / eiscbkfm.pas < prev    next >
Pascal/Delphi Source File  |  1996-09-15  |  6KB  |  223 lines
  1. { FormulaBuilder                }
  2. { YGB Software, Inc.            }
  3. { Copyright 1995 Clayton Collie }
  4. { All rights reserved           }
  5.  
  6. { EIS Demo using callbacks. Note that for the sake of brevity, }
  7. { Database variables are not handled                           }
  8. unit Eiscbkfm;
  9. interface
  10. uses
  11.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  12.   StdCtrls, Forms, DBCtrls, DB, DBGrids,
  13.   SSheet,FBCOMP,FBDBCOMP,FBCALC,
  14.   Grids,DBTables, ExtCtrls, Buttons;
  15.  
  16. type
  17.   { since SetFieldCallbacks is a protected member of TDSExpression, we }
  18.   { simply declare a dummy descendant to be able to get at the protected }
  19.   { parts of TDSExpression }
  20.   TNewExpression = Class(TDSExpression)
  21.   end;
  22.  
  23.   TForm2 = class(TForm)
  24.     DBGrid1: TDBGrid;
  25.     DBNavigator: TDBNavigator;
  26.     Panel1: TPanel;
  27.     DataSource1: TDataSource;
  28.     Panel2: TPanel;
  29.     Table1: TTable;
  30.     Panel3: TPanel;
  31.     SSheetGrid: TStringGrid;
  32.     GroupBox1: TGroupBox;
  33.     ResultPanel: TPanel;
  34.     FormulaEdit: TEdit;
  35.     BitBtn1: TBitBtn;
  36.     SpeedButton1: TSpeedButton;
  37.     procedure FormCreate(Sender: TObject);
  38.     procedure SSheetGridGetEditText(Sender: TObject; ACol, ARow: Longint;
  39.       var Value: OpenString);
  40.     procedure SSheetGridSetEditText(Sender: TObject; ACol, ARow: Longint;
  41.       const Value: String);
  42.     procedure FormDestroy(Sender: TObject);
  43.     procedure SpeedButton1Click(Sender: TObject);
  44.   private
  45.     { private declarations }
  46.     Sheet : TSpreadSheet;
  47.   public
  48.     { public declarations }
  49.     Expression : TNewExpression;
  50.   end;
  51.  
  52. var
  53.   Form2: TForm2;
  54.  
  55. implementation
  56. {$R *.DFM}
  57.  
  58. {
  59. The syntax for "spreadsheet" cell access in [RnCn] where n is an integer,
  60. for example :
  61.  
  62.        "[R1C1] * [R2C2] - [R5C2]"
  63. }
  64.  
  65.  
  66.  Function SheetFindVarCBK(vname        : pchar;
  67.                           var vtype    : byte;
  68.                           var vardata  : longint;
  69.                           CBKData      : longint):integer; export;
  70.  
  71.  var   r,c      : word;
  72.        theSheet : TSpreadSheet;
  73.  begin
  74.    result := EXPR_SUCCESS;
  75.    if not ParseCellname(strpas(vname),r,c) then
  76.    begin
  77.       vtype := vtNONE;
  78.       exit;
  79.    end;
  80.    theSheet := TSpreadSheet( CBKData ); { Cast CBKData back into spreadsheet }
  81.    { check to see if r and c are within range. If not, return an error }
  82.    if (r > MAXROWS) or (c > MAXCOLS) then
  83.    begin
  84.      Result := EXPR_RANGE_ERROR;
  85.      Exit;
  86.    end;
  87.     { in our spreadsheet, all values are floats }
  88.     vtype := vtFLOAT;
  89.     { typecast vardata to a pointer to our actual value. This speeds }
  90.     { up variable access when the value of the cell needs to be retrieved. }
  91.     { see GetVariable function }
  92.     vardata := longint( @theSheet.sheetData[r,c] );
  93.  end; {}
  94.  
  95.  
  96. function SheetGetVarCBK(vname     : pchar;
  97.                         var Value : TValueRec;
  98.                         vardata   : longint;
  99.                         CBKData   : longint) :integer; export;
  100.  
  101. var theSheet : TSpreadSheet absolute CBKData;
  102. begin
  103.   result := EXPR_SUCCESS;
  104.   { we could retrieve the value this way :
  105.  
  106.      ParseCellName(varname,r,c);
  107.      value.vFloat := TheSheet.SheetData[r,c];
  108.  
  109.      but since we set vardata to point directly to the data, all we need to
  110.      do is typecast and dereference the vardata parameter (see above). This
  111.      is a bit faster, since we skip the ParseCellName function call.
  112.      }
  113.      value.vFloat := PDouble(VarData)^;
  114.      { no errors occurred so we dont have to set errcode. Its value is
  115.        EXPR_SUCCESS on entry }
  116. end; { getVariable }
  117.  
  118.  
  119.  
  120. Function SheetSetVarCBK(vname     : pchar;
  121.                         value     : TValueRec;
  122.                         vardata   : longint;
  123.                         CBKData   : longint):integer; export;
  124. begin
  125.   { we could set the value this way :
  126.  
  127.      ParseCellName(varname,r,c);
  128.      TheSheet.SheetData[r,c] := value.vFloat;
  129.  
  130.      but since we set vardata to point directly to the data, all we need to
  131.      do is typecast and dereference the vardata parameter (see above). This
  132.      is a bit faster, since we skip the ParseCellName function call.
  133.      }
  134.      PDouble(VarData)^ := value.vFloat;
  135.      { no errors occurred so we dont have to set errcode. Its value is
  136.        EXPR_SUCCESS on entry }
  137. end; { setVariable }
  138.  
  139.  
  140.  
  141.  
  142.  
  143. procedure TForm2.FormCreate(Sender: TObject);
  144. var r, c   : integer;
  145.     tmpstr : String[15];
  146. begin
  147.   Table1.Open;
  148.   Sheet      := TSpreadSheet.Create;
  149.   Expression := TNewExpression.Create(Self);
  150. { Note the last parameter passed to SetFieldCallbacks. This is the value that }
  151. { is passed to the CBKData parameter of the callback functions. We use this }
  152. { fact to pass our instance of the spreadsheet to the callback functions }
  153.   Expression.SetVariableCallbacks(SheetFindVarCBK,
  154.                                   SheetGetVarCBK,
  155.                                   SheetSetVarCBK,
  156.                                   longint(Sheet));
  157.   Expression.Dataset   := Table1;
  158.   Expression.UseEvents := True;
  159.   for r := 0 to MAXROWS do
  160.   for c := 0 to MAXCOLS do
  161.   begin
  162.     if (r + c = 0) then continue;
  163.     if (r = 0) then
  164.     begin
  165.       tmpStr := 'C'+IntToStr(c);
  166.       SSheetGrid.Cells[c,r] := tmpstr;
  167.     end
  168.    else
  169.     if (c = 0) then
  170.     begin
  171.       tmpStr := 'R'+IntToStr(r);
  172.       SSheetGrid.Cells[c,r] := tmpstr;
  173.     end
  174.    else
  175.     begin
  176.        tmpstr := FloatToStrF(Sheet.SheetData[r,c],ffCurrency,10,2);
  177.        SSheetGrid.Cells[c,r] := tmpstr;
  178.     end;
  179.   end;
  180. end;
  181.  
  182.  
  183. procedure TForm2.SSheetGridGetEditText(Sender: TObject; ACol,
  184.   ARow: Longint; var Value: OpenString);
  185. begin
  186.    Value := FloatToStrF(Sheet.SheetData[ARow,Acol],ffCurrency,10,2);
  187. end;
  188.  
  189. procedure TForm2.SSheetGridSetEditText(Sender: TObject; ACol,
  190.   ARow: Longint; const Value: String);
  191. var temp : double;
  192. begin
  193.   Try
  194.     Sheet.SheetData[ARow,ACol] := StrToFloat(value);
  195.   except
  196.     {}
  197.   end;
  198. end;
  199.  
  200. procedure TForm2.FormDestroy(Sender: TObject);
  201. begin
  202.   Expression.Free;
  203. end;
  204.  
  205. procedure TForm2.SpeedButton1Click(Sender: TObject);
  206. var stringExpr : String;
  207. begin
  208.   StringExpr := FormulaEdit.Text;
  209.   if StringExpr <> '' then
  210.   begin
  211.     Expression.Formula := StringExpr;
  212.     if Expression.Status <> EXPR_SUCCESS then
  213.     begin
  214.       MessageBeep( MB_ICONHAND );
  215.       ResultPanel.Caption := Expression.StatusText;
  216.     end
  217.      else
  218.        ResultPanel.Caption := Expression.AsString;
  219.   end;
  220. end;
  221.  
  222. end.
  223.